home *** CD-ROM | disk | FTP | other *** search
Text File | 1997-06-05 | 851 b | 26 lines | [TEXT/ScoM] |
- (defun symbol-stretch (symbols frames)
- (cond ((greaterp (length symbols) frames)
- (symbol-trim frames symbols))
- (t (frame-expand symbols frames))))
-
- (defun frame-expand (symbols frames)
- (prog (out gap count abs-frame prev-frame)
- (setq gap (quotient (float frames) (length symbols)))
- (setq count 1)
- (setq prev-frame 0)
- loop
- (cond ((null symbols) (return out)))
- (setq abs-frame (round (times count gap)))
- (setq out (append out
- (cons-n (car symbols)
- (difference abs-frame prev-frame))))
- (setq prev-frame abs-frame)
- (setq count (add1 count))
- (setq symbols (cdr symbols))
- (go loop)))
-
- ; stretches symbols to a given length
-
- (symbol-stretch '(a b c) 12)
- --> (a a a a b b b b c c c c)
-